<%
Class FastAsp_DB
    Private m_Table
    Private m_Where
    Private m_Order
    Private m_Field
    Private m_Join
    Private m_Page
    Private m_PageSize
    Private m_PageObj
    Private m_Conn
    Private m_LastSql
    Private m_DbType
    Private m_Prefix
    Private m_LastError     '最后的错误信息
    Private m_LastErrNum    '最后的错误号
    Private m_Debug         '是否调试模式
    Private m_Group
    Private m_Having
    Private m_Union
    Private m_Cache
    Private m_Relations    '关联关系配置
    Private m_Binds       '数据绑定
    Private m_RelationData '关联数据缓存
    Private m_Lock        '查询锁定类型
    Private m_SubQuery    '子查询SQL
    Private m_ConnPool      '连接池
    Private m_MaxPoolSize   '最大连接数
    Private m_MinPoolSize   '最小连接数
    Private m_PoolTimeout   '连接超时时间
    
    Private Sub Class_Initialize()
        Set m_PageObj = New FastAsp_Page
        m_DbType = GetConfig("DbType")
        m_Prefix = GetConfig("DbPrefix")
        InitConn() '初始化数据库连接
        m_Debug = GetConfig("DebugMode")
        m_LastError = ""
        m_LastErrNum = 0
        m_Group = ""
        m_Having = ""
        m_Union = ""
        m_Cache = 0
        Set m_Relations = Server.CreateObject("Scripting.Dictionary")
        Set m_Binds = Server.CreateObject("Scripting.Dictionary")
        Set m_RelationData = Server.CreateObject("Scripting.Dictionary")
        m_Lock = ""
        m_SubQuery = ""
        m_MaxPoolSize = GetConfig("DbMaxPoolSize")
        m_MinPoolSize = GetConfig("DbMinPoolSize")
        m_PoolTimeout = GetConfig("DbPoolTimeout")
        Set m_ConnPool = Server.CreateObject("Scripting.Dictionary")
        InitPool() '初始化连接池
    End Sub
    
    '初始化数据库连接
    Private Sub InitConn()
        Select Case LCase(m_DbType)
            Case "access"
                Set m_Conn = Server.CreateObject("ADODB.Connection")
                m_Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(GetConfig("DbName"))
            Case "mssql"
                Set m_Conn = Server.CreateObject("ADODB.Connection")
                m_Conn.Open "Provider=SQLOLEDB;Server=" & GetConfig("DbHost") & ";Database=" & GetConfig("DbName") & _
                           ";Uid=" & GetConfig("DbUser") & ";Pwd=" & GetConfig("DbPass")
            Case "mysql"
                Set m_Conn = Server.CreateObject("ADODB.Connection")
                m_Conn.Open "Driver={MySQL ODBC 5.3 ANSI Driver};Server=" & GetConfig("DbHost") & ";Database=" & GetConfig("DbName") & _
                           ";User=" & GetConfig("DbUser") & ";Password=" & GetConfig("DbPass") & ";Option=3;"
        End Select
    End Sub
    
    '链式方法
    Public Function Table(byval tableName)
        If m_Prefix <> "" Then
            m_Table = m_Prefix & tableName
        Else
            m_Table = tableName
        End If
        Set Table = Me
    End Function
    
    Public Function Where(byval condition)
        If TypeName(condition) = "Dictionary" Then
            Dim key, whereSql
            For Each key In condition
                If whereSql <> "" Then whereSql = whereSql & " AND "
                If IsNull(condition(key)) Then
                    whereSql = whereSql & key & " IS NULL"
                ElseIf Left(key, 1) = "_" Then '特殊条件处理
                    whereSql = whereSql & Mid(key, 2) & condition(key)
                Else
                    whereSql = whereSql & key & "='" & Replace(condition(key), "'", "''") & "'"
                End If
            Next
            m_Where = whereSql
        ElseIf IsArray(condition) Then
            m_Where = Join(condition, " AND ")
        Else
            m_Where = condition
        End If
        Set Where = Me
    End Function
    
    Public Function Order(byval orderBy)
        m_Order = orderBy
        Set Order = Me
    End Function
    
    Public Function Field(byval fields)
        If IsArray(fields) Then
            m_Field = Join(fields, ",")
        ElseIf Left(fields, 1) = "-" Then '排除模式
            Dim allFields, excludeFields, i
            allFields = GetTableFields(m_Table) '获取表所有字段
            excludeFields = Split(Mid(fields, 2), ",")
            For i = 0 To UBound(excludeFields)
                allFields = Replace(allFields, "," & Trim(excludeFields(i)) & ",", ",")
            Next
            m_Field = Mid(allFields, 2, Len(allFields)-2)
        Else
            m_Field = fields
        End If
        Set Field = Me
    End Function
    
    Public Function Join(byval joinTable, byval condition, byval joinType)
        If m_Prefix <> "" Then
            joinTable = m_Prefix & joinTable
        End If
        If joinType = "" Then joinType = "LEFT"
        m_Join = m_Join & " " & UCase(joinType) & " JOIN " & joinTable & " ON " & condition
        Set Join = Me
    End Function
    
    Public Function Page(byval pageSize)
        m_PageSize = pageSize
        Set Page = Me
    End Function
    
    '构建SQL语句
    Private Function BuildSql()
        Dim sql
        If m_Field = "" Then m_Field = "*"
        sql = "SELECT " & m_Field & " FROM " & m_Table & m_Lock
        
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then 
            sql = sql & " WHERE " & m_Where
            If m_SubQuery <> "" Then sql = sql & " AND " & m_SubQuery
        ElseIf m_SubQuery <> "" Then
            sql = sql & " WHERE " & m_SubQuery
        End If
        If m_Group <> "" Then sql = sql & " GROUP BY " & m_Group
        If m_Having <> "" Then sql = sql & " HAVING " & m_Having
        If m_Order <> "" Then sql = sql & " ORDER BY " & m_Order
        If m_Union <> "" Then sql = sql & m_Union
        
        m_LastSql = sql
        BuildSql = sql
    End Function
    
    '执行查询
    Public Function Find()
        On Error Resume Next
        Dim rs, sql
        sql = BuildSql()
        Set rs = m_Conn.Execute(sql)
        
        If Err.Number <> 0 Then
            SetError Err.Number, Err.Description
            Set Find = Nothing
            Exit Function
        End If
        
        If Not rs.EOF Then
            Set Find = rs.GetRows(1, 0)
        Else
            Set Find = Nothing
        End If
        rs.Close
        Set rs = Nothing
        On Error Goto 0
    End Function
    
    Public Function [Select]()
        Dim rs, sql, result, cacheKey
        
        '如果启用缓存，先尝试从缓存获取
        If m_Cache > 0 Then
            cacheKey = GetCacheKey()
            result = GetCache(cacheKey)
            If Not IsEmpty(result) Then
                Set [Select] = result
                Exit Function
            End If
        End If
        
        sql = BuildSql()
        Set rs = m_Conn.Execute(sql)
        
        If Not rs.EOF Then
            Set result = rs.GetRows(-1, 0)
            '处理关联数据
            If m_Relations.Count > 0 Then
                result = HandleRelations(result)
            End If
            
            '如果启用缓存，将结果存入缓存
            If m_Cache > 0 Then
                SetCache cacheKey, result, m_Cache
            End If
            
            Set [Select] = result
        Else
            Set [Select] = Nothing
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    Public Function Pager()
        Dim rs, sql, totalSql, page
        
        '获取总记录数
        totalSql = "SELECT COUNT(*) FROM " & m_Table
        If m_Join <> "" Then totalSql = totalSql & m_Join
        If m_Where <> "" Then totalSql = totalSql & " WHERE " & m_Where
        
        Set rs = m_Conn.Execute(totalSql)
        m_PageObj.TotalRows = rs(0)
        rs.Close
        
        '获取当前页码
        page = Request(GetConfig("PageParam"))
        If page = "" Then page = 1
        m_PageObj.CurrentPage = page
        m_PageObj.PageSize = m_PageSize
        
        '构建分页SQL
        Select Case LCase(m_DbType)
            Case "access"
                sql = BuildPageSqlAccess()
            Case "mssql" 
                sql = BuildPageSqlMssql()
            Case "mysql"
                sql = BuildPageSqlMysql()
        End Select
        
        Set rs = m_Conn.Execute(sql)
        If Not rs.EOF Then
            Set Pager = rs.GetRows(-1, 0)
        Else
            Set Pager = Nothing
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    '获取分页对象
    Public Property Get PageObj
        Set PageObj = m_PageObj
    End Property
    
    '获取最后执行的SQL
    Public Property Get LastSql
        LastSql = m_LastSql
    End Property
    
    Private Sub Class_Terminate()
        Dim key, conn
        For Each key In m_ConnPool.Keys
            Set conn = m_ConnPool(key)
            If Not conn Is Nothing Then
                If conn.State = 1 Then conn.Close
                Set conn = Nothing
            End If
        Next
        Set m_ConnPool = Nothing
        Set m_PageObj = Nothing
    End Sub
    
    'Access分页SQL构建
    Private Function BuildPageSqlAccess()
        Dim sql, startRow
        startRow = (m_PageObj.CurrentPage - 1) * m_PageSize
        
        sql = "SELECT TOP " & m_PageSize & " * FROM ("
        sql = sql & "SELECT TOP " & m_PageSize & " * FROM ("
        sql = sql & "SELECT TOP " & (startRow + m_PageSize) & " " & m_Field
        sql = sql & " FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        If m_Order <> "" Then sql = sql & " ORDER BY " & m_Order
        sql = sql & ") AS T1 ORDER BY "
        
        '反转排序
        If InStr(LCase(m_Order), " desc") > 0 Then
            sql = sql & Replace(m_Order, " DESC", " ASC")
        Else
            sql = sql & Replace(m_Order, " ASC", " DESC")
        End If
        
        sql = sql & ") AS T2 "
        If m_Order <> "" Then sql = sql & " ORDER BY " & m_Order
        
        m_LastSql = sql
        BuildPageSqlAccess = sql
    End Function
    
    'MSSQL分页SQL构建
    Private Function BuildPageSqlMssql()
        Dim sql, startRow
        startRow = (m_PageObj.CurrentPage - 1) * m_PageSize
        
        sql = "SELECT TOP " & m_PageSize & " * FROM ("
        sql = sql & "SELECT ROW_NUMBER() OVER (ORDER BY " & IIF(m_Order<>"", m_Order, "1") & ") AS RowNum,"
        sql = sql & m_Field & " FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        sql = sql & ") AS T WHERE RowNum > " & startRow
        
        m_LastSql = sql
        BuildPageSqlMssql = sql
    End Function
    
    'MySQL分页SQL构建
    Private Function BuildPageSqlMysql()
        Dim sql, startRow
        startRow = (m_PageObj.CurrentPage - 1) * m_PageSize
        
        sql = "SELECT " & m_Field & " FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        If m_Order <> "" Then sql = sql & " ORDER BY " & m_Order
        sql = sql & " LIMIT " & startRow & "," & m_PageSize
        
        m_LastSql = sql
        BuildPageSqlMysql = sql
    End Function
    
    '插入数据
    Public Function Insert(byval data)
        Dim sql, fields, values, key
        
        For Each key In data
            If fields <> "" Then
                fields = fields & ","
                values = values & ","
            End If
            fields = fields & key
            values = values & "'" & Replace(data(key), "'", "''") & "'"
        Next
        
        sql = "INSERT INTO " & m_Table & "(" & fields & ") VALUES(" & values & ")"
        m_LastSql = sql
        
        If LCase(m_DbType) = "access" Then
            m_Conn.Execute sql
            sql = "SELECT @@IDENTITY AS ID"
            Dim rs : Set rs = m_Conn.Execute(sql)
            Insert = rs("ID")
            rs.Close
            Set rs = Nothing
        Else
            m_Conn.Execute sql
            Insert = m_Conn.Execute("SELECT SCOPE_IDENTITY() AS ID")(0)
        End If
    End Function
    
    '更新数据
    Public Function Update(byval data)
        Dim sql, setSql, key
        
        For Each key In data
            If setSql <> "" Then setSql = setSql & ","
            setSql = setSql & key & "='" & Replace(data(key), "'", "''") & "'"
        Next
        
        sql = "UPDATE " & m_Table & " SET " & setSql
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        m_LastSql = sql
        m_Conn.Execute sql
        Update = m_Conn.Execute("SELECT @@ROWCOUNT AS Rows")(0)
    End Function
    
    '删除数据
    Public Function Delete()
        Dim sql
        sql = "DELETE FROM " & m_Table
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        m_LastSql = sql
        m_Conn.Execute sql
        Delete = m_Conn.Execute("SELECT @@ROWCOUNT AS Rows")(0)
    End Function
    
    '执行SQL语句
    Public Function Execute(byval sql)
        On Error Resume Next
        Dim conn
        Set conn = GetConnection()
        
        m_LastSql = sql
        Set Execute = conn.Execute(sql)
        
        If Err.Number <> 0 Then
            SetError Err.Number, Err.Description
            Set Execute = Nothing
        End If
        
        ReleaseConnection conn
        On Error Goto 0
    End Function
    
    '开始事务
    Public Function BeginTrans()
        On Error Resume Next
        m_Conn.BeginTrans
        If Err.Number <> 0 Then
            SetError Err.Number, "开启事务失败: " & Err.Description
            BeginTrans = False
        Else
            BeginTrans = True
        End If
        On Error Goto 0
    End Function
    
    '提交事务
    Public Function CommitTrans()
        On Error Resume Next
        m_Conn.CommitTrans
        If Err.Number <> 0 Then
            SetError Err.Number, "提交事务失败: " & Err.Description
            CommitTrans = False
        Else
            CommitTrans = True
        End If
        On Error Goto 0
    End Function
    
    '回滚事务
    Public Function RollbackTrans()
        On Error Resume Next
        m_Conn.RollbackTrans
        If Err.Number <> 0 Then
            SetError Err.Number, "回滚事务失败: " & Err.Description
            RollbackTrans = False
        Else
            RollbackTrans = True
        End If
        On Error Goto 0
    End Function
    
    '重置查询条件
    Private Sub ResetQuery()
        m_Table = ""
        m_Where = ""
        m_Order = ""
        m_Field = ""
        m_Join = ""
        m_Page = 0
        m_PageSize = 0
        m_Group = ""
        m_Having = ""
        m_Union = ""
        m_Cache = 0
        Set m_Relations = Server.CreateObject("Scripting.Dictionary")
        Set m_Binds = Server.CreateObject("Scripting.Dictionary")
        Set m_RelationData = Server.CreateObject("Scripting.Dictionary")
        m_Lock = ""
        m_SubQuery = ""
    End Sub
    
    '添加错误处理相关方法
    '设置错误
    Private Sub SetError(byval errNum, byval errMsg)
        m_LastErrNum = errNum
        m_LastError = errMsg
        
        If m_Debug Then
            Response.Write "<div style='color:red;'>"
            Response.Write "Error " & errNum & ": " & errMsg
            If m_LastSql <> "" Then
                Response.Write "<br>SQL: " & m_LastSql
            End If
            Response.Write "</div>"
        End If
        
        '记录错误日志
        If GetConfig("LogError") Then
            Dim logMsg
            logMsg = "Error " & errNum & ": " & errMsg
            If m_LastSql <> "" Then
                logMsg = logMsg & vbCrLf & "SQL: " & m_LastSql
            End If
            WriteLog logMsg, "ERROR"
        End If
    End Sub
    
    '获取最后错误信息
    Public Property Get LastError
        LastError = m_LastError
    End Property
    
    '获取最后错误号
    Public Property Get LastErrNum
        LastErrNum = m_LastErrNum
    End Property
    
    '写入日志
    Private Sub WriteLog(byval msg, byval level)
        Dim fso, logFile, logPath
        logPath = Server.MapPath(GetConfig("LogPath") & "/db_" & Year(Now) & Right("0" & Month(Now), 2) & ".log")
        
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If Not fso.FolderExists(Server.MapPath(GetConfig("LogPath"))) Then
            fso.CreateFolder Server.MapPath(GetConfig("LogPath"))
        End If
        
        Set logFile = fso.OpenTextFile(logPath, 8, True)
        logFile.WriteLine "[" & Now & "] [" & level & "] " & msg
        logFile.Close
        Set logFile = Nothing
        Set fso = Nothing
    End Sub
    
    '设置表别名
    Public Function Alias(byval aliasName)
        m_Table = m_Table & " AS " & aliasName
        Set Alias = Me
    End Function
    
    '分组
    Public Function Group(byval groupBy)
        m_Group = groupBy
        Set Group = Me
    End Function
    
    'Having条件
    Public Function Having(byval havingStr)
        m_Having = havingStr
        Set Having = Me
    End Function
    
    'Union查询
    Public Function Union(byval sql, byval unionType)
        If unionType = "" Then unionType = "UNION"
        m_Union = m_Union & " " & UCase(unionType) & " " & sql
        Set Union = Me
    End Function
    
    '缓存查询结果
    Public Function Cache(byval timeout)
        If timeout = "" Then timeout = GetConfig("CacheTime")
        m_Cache = timeout
        Set Cache = Me
    End Function
    
    '获取表字段列表
    Private Function GetTableFields(byval tableName)
        Dim rs, fields
        fields = ","
        Set rs = m_Conn.OpenSchema(4, Array(Empty, Empty, tableName, Empty))
        Do While Not rs.EOF
            fields = fields & rs("COLUMN_NAME") & ","
            rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing
        GetTableFields = fields
    End Function
    
    '关联查询配置
    Public Function Relation(byval name, byval config)
        If TypeName(config) = "String" Then
            '简单关联配置: "table.foreign_key=local_key"
            Dim arr : arr = Split(config, ".")
            Dim rel : Set rel = Server.CreateObject("Scripting.Dictionary")
            rel.Add "table", arr(0)
            rel.Add "foreign_key", Split(arr(1), "=")(0)
            rel.Add "local_key", Split(arr(1), "=")(1)
            rel.Add "type", "one" '默认一对一关联
            m_Relations.Add name, rel
        ElseIf TypeName(config) = "Dictionary" Then
            '完整关联配置
            m_Relations.Add name, config
        End If
        Set Relation = Me
    End Function
    
    '数据绑定
    Public Function Bind(byval field, byval value)
        m_Binds.Add field, value
        Set Bind = Me
    End Function
    
    '处理关联数据
    Private Function HandleRelations(byval data)
        Dim rel, relName, localKeys, foreignKeys
        Dim relData, relSql, relRs, i
        
        For Each relName In m_Relations.Keys
            Set rel = m_Relations(relName)
            
            '收集关联键值
            Set localKeys = Server.CreateObject("Scripting.Dictionary")
            For i = 0 To UBound(data, 2)
                localKeys.Add data(GetFieldIndex(rel("local_key")), i), ""
            Next
            
            '构建关联查询
            relSql = "SELECT * FROM " & rel("table") & " WHERE " & _
                     rel("foreign_key") & " IN ('" & Join(localKeys.Keys, "','") & "')"
            
            Set relRs = m_Conn.Execute(relSql)
            If Not relRs.EOF Then
                Set relData = relRs.GetRows(-1, 0)
                
                '建立关联数据索引
                Set foreignKeys = Server.CreateObject("Scripting.Dictionary")
                For i = 0 To UBound(relData, 2)
                    If rel("type") = "many" Then
                        '一对多关联
                        If Not foreignKeys.Exists(relData(GetFieldIndex(rel("foreign_key")), i)) Then
                            foreignKeys.Add relData(GetFieldIndex(rel("foreign_key")), i), Server.CreateObject("Scripting.Dictionary")
                        End If
                        foreignKeys(relData(GetFieldIndex(rel("foreign_key")), i)).Add i, relData
                    Else
                        '一对一关联
                        foreignKeys.Add relData(GetFieldIndex(rel("foreign_key")), i), relData
                    End If
                Next
                
                '将关联数据添加到结果中
                m_RelationData.Add relName, foreignKeys
            End If
            relRs.Close
            Set relRs = Nothing
        Next
        
        HandleRelations = data
    End Function
    
    '获取字段索引
    Private Function GetFieldIndex(byval fieldName)
        Dim fields : fields = Split(m_Field, ",")
        Dim i
        For i = 0 To UBound(fields)
            If Trim(fields(i)) = fieldName Then
                GetFieldIndex = i
                Exit Function
            End If
        Next
        GetFieldIndex = -1
    End Function
    
    '获取缓存键
    Private Function GetCacheKey()
        Dim key : key = "DB_" & m_Table & "_" & m_LastSql
        If m_Relations.Count > 0 Then
            key = key & "_REL_" & Join(m_Relations.Keys, ",")
        End If
        GetCacheKey = MD5(key)
    End Function
    
    '从缓存获取数据
    Private Function GetCache(byval key)
        Dim cacheType : cacheType = LCase(GetConfig("CacheType"))
        
        Select Case cacheType
            Case "file"
                GetCache = GetFileCacheData(key)("data")
            Case "memcache"
                GetCache = GetMemCache(key)
            Case Else
                GetCache = Empty
        End Select
    End Function
    
    '设置缓存
    Private Sub SetCache(byval key, byval value, byval timeout)
        Dim cacheType : cacheType = LCase(GetConfig("CacheType"))
        
        Select Case cacheType
            Case "file"
                SetFileCache key, value, timeout
            Case "memcache"
                SetMemCache key, value, timeout
        End Select
    End Sub
    
    '设置文件缓存
    Private Sub SetFileCache(byval key, byval value, byval expire)
        '创建缓存目录
        CreateFolder Server.MapPath(m_Path)
        
        '缓存数据
        Dim data : Set data = Server.CreateObject("Scripting.Dictionary")
        data.Add "data", value
        data.Add "expire", Now() + (expire / 86400) '转换为天数
        data.Add "created", Now()
        
        '保存缓存文件
        Dim cacheFilePath : cacheFilePath = GetCacheFile(key)
        SaveFile cacheFilePath, JSON.Encode(data)
    End Sub
    
    '获取文件缓存数据
    Private Function GetFileCacheData(byval key)
        Dim cacheFilePath : cacheFilePath = GetCacheFile(key)
        If Not FSO.FileExists(cacheFilePath) Then Exit Function
        
        '读取缓存数据
        Dim content : content = LoadFile(cacheFilePath)
        If content = "" Then Exit Function
        
        '解析缓存数据
        Dim data : Set data = JSON.Decode(content)
        If data Is Nothing Then Exit Function
        
        '检查是否过期
        If IsDate(data("expire")) Then
            If Now() > CDate(data("expire")) Then
                FSO.DeleteFile cacheFilePath
                Exit Function
            End If
        End If
        
        Set GetFileCacheData = data
    End Function
    
    '删除文件缓存
    Private Sub DeleteFileCache(byval key)
        Dim cacheFilePath : cacheFilePath = GetCacheFile(key)
        If FSO.FileExists(cacheFilePath) Then FSO.DeleteFile cacheFilePath
    End Sub
    
    '清空文件缓存
    Private Sub ClearFileCache()
        Dim folder : folder = Server.MapPath(m_Path)
        If FSO.FolderExists(folder) Then FSO.DeleteFolder folder
    End Sub
    
    '获取缓存文件路径
    Private Function GetCacheFile(byval key)
        GetCacheFile = Server.MapPath(m_Path & "/" & MD5(key) & ".cache")
    End Function
    
    '序列化数据
    Private Function Serialize(byval data)
        '简单实现，实际使用可能需要更复杂的序列化方法
        Serialize = Join(data, "||")
    End Function
    
    '反序列化数据
    Private Function UnSerialize(byval str)
        '简单实现，实际使用可能需要更复杂的反序列化方法
        UnSerialize = Split(str, "||")
    End Function
    
    'MD5加密
    Private Function MD5(byval str)
        Dim cmd : Set cmd = Server.CreateObject("ADODB.Command")
        cmd.CommandText = "SELECT HashBytes('MD5', ?)"
        cmd.Parameters.Append cmd.CreateParameter("@str", 200, 1, Len(str), str)
        MD5 = cmd.Execute()(0)
        Set cmd = Nothing
    End Function
    
    '查询锁定
    Public Function Lock(byval lockType)
        Select Case UCase(lockType)
            Case "SHARE","EXCLUSIVE","UPDATE","NOLOCK"
                m_Lock = " WITH (" & UCase(lockType) & ")"
        End Select
        Set Lock = Me
    End Function
    
    '聚合查询方法
    Public Function Count(byval field)
        If field = "" Then field = "*"
        Dim sql : sql = "SELECT COUNT(" & field & ") FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        Dim rs : Set rs = m_Conn.Execute(sql)
        If Not rs.EOF Then
            Count = rs(0)
        Else
            Count = 0
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    Public Function Sum(byval field)
        Dim sql : sql = "SELECT SUM(" & field & ") FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        Dim rs : Set rs = m_Conn.Execute(sql)
        If Not rs.EOF Then
            If IsNull(rs(0)) Then
                Sum = 0
            Else
                Sum = rs(0)
            End If
        Else
            Sum = 0
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    Public Function Max(byval field)
        Dim sql : sql = "SELECT MAX(" & field & ") FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        Dim rs : Set rs = m_Conn.Execute(sql)
        If Not rs.EOF Then
            Max = rs(0)
        Else
            Max = Null
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    Public Function Min(byval field)
        Dim sql : sql = "SELECT MIN(" & field & ") FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        Dim rs : Set rs = m_Conn.Execute(sql)
        If Not rs.EOF Then
            Min = rs(0)
        Else
            Min = Null
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    Public Function Avg(byval field)
        Dim sql : sql = "SELECT AVG(" & field & ") FROM " & m_Table
        If m_Join <> "" Then sql = sql & m_Join
        If m_Where <> "" Then sql = sql & " WHERE " & m_Where
        
        Dim rs : Set rs = m_Conn.Execute(sql)
        If Not rs.EOF Then
            If IsNull(rs(0)) Then
                Avg = 0
            Else
                Avg = rs(0)
            End If
        Else
            Avg = 0
        End If
        rs.Close
        Set rs = Nothing
    End Function
    
    '子查询支持
    Public Function SubQuery(byval sql)
        m_SubQuery = "(" & sql & ")"
        Set SubQuery = Me
    End Function
    
    '批量插入
    Public Function InsertAll(byval dataList)
        Dim i, data, fields, values, allValues, key
        fields = ""
        allValues = ""
        
        '获取字段列表
        Set data = dataList(0)
        For Each key In data
            If fields <> "" Then fields = fields & ","
            fields = fields & key
        Next
        
        '构建值列表
        For i = 0 To UBound(dataList)
            Set data = dataList(i)
            values = ""
            For Each key In data
                If values <> "" Then values = values & ","
                values = values & "'" & Replace(data(key), "'", "''") & "'"
            Next
            If allValues <> "" Then allValues = allValues & ","
            allValues = allValues & "(" & values & ")"
        Next
        
        Dim sql : sql = "INSERT INTO " & m_Table & "(" & fields & ") VALUES " & allValues
        m_LastSql = sql
        m_Conn.Execute sql
        InsertAll = m_Conn.Execute("SELECT @@ROWCOUNT AS Rows")(0)
    End Function
    
    '批量更新
    Public Function UpdateAll(byval dataList, byval whereField)
        Dim i, data, sql, cases, where, key
        cases = ""
        where = ""
        
        '构建CASE语句
        For Each key In dataList(0)
            If key <> whereField Then
                If cases <> "" Then cases = cases & ","
                cases = cases & key & " = CASE " & whereField
                For i = 0 To UBound(dataList)
                    Set data = dataList(i)
                    cases = cases & " WHEN '" & data(whereField) & "' THEN '" & Replace(data(key), "'", "''") & "'"
                Next
                cases = cases & " END"
            End If
        Next
        
        '构建WHERE条件
        For i = 0 To UBound(dataList)
            Set data = dataList(i)
            If where <> "" Then where = where & ","
            where = where & "'" & data(whereField) & "'"
        Next
        
        sql = "UPDATE " & m_Table & " SET " & cases & " WHERE " & whereField & " IN (" & where & ")"
        m_LastSql = sql
        m_Conn.Execute sql
        UpdateAll = m_Conn.Execute("SELECT @@ROWCOUNT AS Rows")(0)
    End Function
    
    '批量删除
    Public Function DeleteAll(byval idList)
        Dim sql, ids
        If IsArray(idList) Then
            ids = Join(idList, "','")
        Else
            ids = idList
        End If
        
        sql = "DELETE FROM " & m_Table & " WHERE id IN ('" & ids & "')"
        If m_Where <> "" Then sql = sql & " AND " & m_Where
        
        m_LastSql = sql
        m_Conn.Execute sql
        DeleteAll = m_Conn.Execute("SELECT @@ROWCOUNT AS Rows")(0)
    End Function
    
    '子查询支持扩展
    Public Function Exists(byval sql)
        m_SubQuery = " EXISTS (" & sql & ")"
        Set Exists = Me
    End Function
    
    Public Function NotExists(byval sql)
        m_SubQuery = " NOT EXISTS (" & sql & ")"
        Set NotExists = Me
    End Function
    
    Public Function [In](byval field, byval sql)
        m_SubQuery = field & " IN (" & sql & ")"
        Set [In] = Me
    End Function
    
    Public Function NotIn(byval field, byval sql)
        m_SubQuery = field & " NOT IN (" & sql & ")"
        Set NotIn = Me
    End Function
    
    '复杂子查询示例方法
    Public Function WhereExists(byval table, byval condition)
        Dim sql : sql = "SELECT 1 FROM " & table & " WHERE " & condition
        Set WhereExists = Exists(sql)
    End Function
    
    Public Function WhereNotExists(byval table, byval condition)
        Dim sql : sql = "SELECT 1 FROM " & table & " WHERE " & condition
        Set WhereNotExists = NotExists(sql)
    End Function
    
    '初始化连接池
    Private Sub InitPool()
        Dim i
        For i = 1 To m_MinPoolSize
            AddConnection()
        Next
    End Sub
    
    '添加连接到池中
    Private Sub AddConnection()
        Dim conn : Set conn = CreateConnection()
        m_ConnPool.Add GetConnKey(), conn
    End Sub
    
    '创建新连接
    Private Function CreateConnection()
        Dim conn : Set conn = Server.CreateObject("ADODB.Connection")
        Select Case LCase(m_DbType)
            Case "access"
                conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(GetConfig("DbName"))
            Case "mssql"
                conn.Open "Provider=SQLOLEDB;Server=" & GetConfig("DbHost") & ";Database=" & GetConfig("DbName") & _
                         ";Uid=" & GetConfig("DbUser") & ";Pwd=" & GetConfig("DbPass")
            Case "mysql"
                conn.Open "Driver={MySQL ODBC 5.3 ANSI Driver};Server=" & GetConfig("DbHost") & ";Database=" & GetConfig("DbName") & _
                         ";User=" & GetConfig("DbUser") & ";Password=" & GetConfig("DbPass") & ";Option=3;"
        End Select
        Set CreateConnection = conn
    End Function
    
    '获取连接键名
    Private Function GetConnKey()
        GetConnKey = "CONN_" & m_ConnPool.Count + 1
    End Function
    
    '从池中获取连接
    Private Function GetConnection()
        Dim conn, key
        
        '检查是否有可用连接
        For Each key In m_ConnPool.Keys
            Set conn = m_ConnPool(key)
            If conn.State = 1 Then '连接打开状态
                Set GetConnection = conn
                Exit Function
            End If
        Next
        
        '如果没有可用连接且未达到最大连接数，则创建新连接
        If m_ConnPool.Count < m_MaxPoolSize Then
            AddConnection()
            Set GetConnection = m_ConnPool(m_ConnPool.Keys(m_ConnPool.Count - 1))
        Else
            '等待超时时间后再次尝试
            WScript.Sleep m_PoolTimeout
            Set GetConnection = GetConnection()
        End If
    End Function
    
    '释放连接到池中
    Private Sub ReleaseConnection(byref conn)
        If Not conn Is Nothing Then
            If conn.State = 0 Then '连接关闭状态
                conn.Open
            End If
        End If
    End Sub
    
    '原始SQL查询
    Public Function Raw(byval sql)
        m_LastSql = sql
        Set Raw = Execute(sql)
    End Function
    
    '子查询构建器
    Public Function BuildSubQuery(byval callback)
        Dim builder : Set builder = New FastAsp_DB
        callback(builder)
        BuildSubQuery = "(" & builder.BuildSql() & ")"
    End Function
    
    'UNION查询构建器
    Public Function BuildUnion(byval queries, byval unionType)
        Dim i, sql
        If unionType = "" Then unionType = "UNION"
        
        For i = 0 To UBound(queries)
            If sql <> "" Then sql = sql & " " & UCase(unionType) & " "
            If TypeName(queries(i)) = "FastAsp_DB" Then
                sql = sql & "(" & queries(i).BuildSql() & ")"
            Else
                sql = sql & queries(i)
            End If
        Next
        
        BuildUnion = sql
    End Function
    
    '复杂条件构建
    Public Function WhereComplex(byval callback)
        Dim builder : Set builder = New FastAsp_DB
        callback(builder)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & "(" & builder.GetWhere() & ")"
        Set WhereComplex = Me
    End Function
    
    '获取WHERE条件
    Public Function GetWhere()
        GetWhere = m_Where
    End Function
    
    'OR条件
    Public Function OrWhere(byval condition)
        If m_Where <> "" Then m_Where = m_Where & " OR "
        If TypeName(condition) = "Dictionary" Then
            Dim key, whereSql
            For Each key In condition
                If whereSql <> "" Then whereSql = whereSql & " AND "
                If IsNull(condition(key)) Then
                    whereSql = whereSql & key & " IS NULL"
                ElseIf Left(key, 1) = "_" Then
                    whereSql = whereSql & Mid(key, 2) & condition(key)
                Else
                    whereSql = whereSql & key & "='" & Replace(condition(key), "'", "''") & "'"
                End If
            Next
            m_Where = m_Where & "(" & whereSql & ")"
        Else
            m_Where = m_Where & "(" & condition & ")"
        End If
        Set OrWhere = Me
    End Function
    
    'Between条件
    Public Function WhereBetween(byval field, byval value1, byval value2)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & field & " BETWEEN '" & value1 & "' AND '" & value2 & "'"
        Set WhereBetween = Me
    End Function
    
    'Not Between条件
    Public Function WhereNotBetween(byval field, byval value1, byval value2)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & field & " NOT BETWEEN '" & value1 & "' AND '" & value2 & "'"
        Set WhereNotBetween = Me
    End Function
    
    'IN条件
    Public Function WhereIn(byval field, byval values)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        If IsArray(values) Then
            m_Where = m_Where & field & " IN ('" & Join(values, "','") & "')"
        Else
            m_Where = m_Where & field & " IN (" & values & ")"
        End If
        Set WhereIn = Me
    End Function
    
    'NOT IN条件
    Public Function WhereNotIn(byval field, byval values)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        If IsArray(values) Then
            m_Where = m_Where & field & " NOT IN ('" & Join(values, "','") & "')"
        Else
            m_Where = m_Where & field & " NOT IN (" & values & ")"
        End If
        Set WhereNotIn = Me
    End Function
    
    'NULL条件
    Public Function WhereNull(byval field)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & field & " IS NULL"
        Set WhereNull = Me
    End Function
    
    'NOT NULL条件
    Public Function WhereNotNull(byval field)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & field & " IS NOT NULL"
        Set WhereNotNull = Me
    End Function
    
    'LIKE条件
    Public Function WhereLike(byval field, byval pattern)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & field & " LIKE '" & pattern & "'"
        Set WhereLike = Me
    End Function
    
    'NOT LIKE条件
    Public Function WhereNotLike(byval field, byval pattern)
        If m_Where <> "" Then m_Where = m_Where & " AND "
        m_Where = m_Where & field & " NOT LIKE '" & pattern & "'"
        Set WhereNotLike = Me
    End Function
End Class
%> 